home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog6.arj / ACCMENU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  3.0 KB  |  123 lines
  1. { AccMenu.pas -- Add accelerator keys to menu commands }
  2.  
  3. program AccMenu;
  4.  
  5. {$R accmenu.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects;
  8.  
  9. const
  10.  
  11.   id_Menu  = 100;   { Menu resource ID }
  12.   id_Accs  = 200;   { Accelerator resource ID }
  13.   cm_About = 101;   { About command ID }
  14.   cm_Help  = 102;   { Help command ID }
  15.   cm_Quit  = 103;   { Exit command ID }
  16.  
  17. type
  18.  
  19.   AccMenuApplication = object(TApplication)
  20.     procedure InitInstance; virtual;
  21.     procedure InitMainWindow; virtual;
  22.   end;
  23.  
  24.   PAccMenuWindow = ^AccMenuWindow;
  25.   AccMenuWindow = object(TWindow)
  26.     CurrentHotKey: Word;
  27.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  28.     procedure CMAbout(var Msg: TMessage);
  29.     procedure CMHelp(var Msg: TMessage);
  30.       virtual cm_First + cm_Help;
  31.     procedure WMCommand(var Msg: TMessage);
  32.       virtual wm_First + wm_Command;
  33.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  34.       virtual;
  35.   end;
  36.  
  37.  
  38. { AccMenuApplication }
  39.  
  40. {- Initialize this instance of the application }
  41. procedure AccMenuApplication.InitInstance;
  42. begin
  43.   TApplication.InitInstance;
  44.   HAccTable := LoadAccelerators(HInstance, PChar(id_Accs))
  45. end;
  46.  
  47. {- Initialize AccMenuApplication object's window }
  48. procedure AccMenuApplication.InitMainWindow;
  49. begin
  50.   MainWindow := New(PAccMenuWindow, Init(nil, 'Accelerated Menu'))
  51. end;
  52.  
  53.  
  54. { AccMenuWindow }
  55.  
  56. {- Construct AccWindow object }
  57. constructor AccMenuWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  58. begin
  59.   TWindow.Init(AParent, ATitle);
  60.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
  61.   CurrentHotKey := 0  { none }
  62. end;
  63.  
  64. {- Execute the About command. Called by WMCommand }
  65. procedure AccMenuWindow.CMAbout(var Msg: TMessage);
  66. begin
  67.   MessageBox(HWindow, 'Accelerator Demonstration', 'About', mb_Ok)
  68. end;
  69.  
  70. {- Execute the Help command }
  71. procedure AccMenuWindow.CMHelp(var Msg: TMessage);
  72. begin
  73.   MessageBox(HWindow, 'Press F1...F9', 'Help!', mb_Ok)
  74. end;
  75.  
  76. {- Intercept wm_Command messages }
  77. procedure AccMenuWindow.WMCommand(var Msg: TMessage);
  78. begin
  79.   case Msg.WParam of
  80.     cm_About: CMAbout(Msg);
  81.     cm_Quit: CloseWindow;
  82.     vk_F1 .. vk_F9:
  83.       begin
  84.         CurrentHotKey := Msg.WParam;
  85.         InvalidateRect(HWindow, nil, true)
  86.       end
  87.   else
  88.     TWindow.WMCommand(Msg)
  89.   end
  90. end;
  91.  
  92. {- Display current hot key (if any) }
  93. procedure AccMenuWindow.Paint(PaintDC: HDC;
  94.   var PaintInfo: TPaintStruct);
  95. var
  96.   HotKeyStr: string[5];
  97.   S: string[40];
  98. begin
  99.   TWindow.Paint(PaintDC, PaintInfo);
  100.   if CurrentHotKey = 0 then
  101.     HotKeyStr := 'x'
  102.   else
  103.     Str(CurrentHotKey - vk_F1 + 1, HotKeyStr);
  104.   S := 'Current hot key = F' + HotKeyStr;
  105.   TextOut(PaintDC, 120, 60, @S[1], Length(S))
  106. end;
  107.  
  108. var
  109.  
  110.   AccMenuApp: AccMenuApplication;
  111.  
  112. begin
  113.   AccMenuApp.Init('AccMenuApp');
  114.   AccMenuApp.Run;
  115.   AccMenuApp.Done
  116. end.
  117.  
  118.  
  119. {--------------------------------------------------------------
  120.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  121.   Revision 1.00    Date: 2/22/1991
  122. ---------------------------------------------------------------}
  123.